Cargando Libreias

library(cluster)
library(dplyr)
library(ggplot2)
library(readr)
library(Rtsne)
library(NbClust)
library(factoextra)
library(purrr)
library(stringr)
library(expss)
library(skimr)
library(DataExplorer)
library(tidyr)
library(dummies)
library(sjmisc)
library(corrplot)
library(MASS)

Cargando los datos

ic_nd <- read.csv("ic_nd1.csv", header=TRUE) %>% dplyr::select(data_productividad_per,data_Tcamp ,
                                data_sumCOD,
                                data_sumHRSLB,
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_T_RangoEdad,
                                data_Testado_civil,
                                data_Tsexo,
                                data_T_numero_hijos,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_total,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa)%>% mutate(sede_cod='Ica')
ir_nd <- read.csv("ir_nd1.csv", header=TRUE) %>% dplyr::select(data_productividad_per,data_Tcamp ,
                                data_sumCOD,
                                data_sumHRSLB,
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_T_RangoEdad,
                                data_Testado_civil,
                                data_Tsexo,
                                data_T_numero_hijos,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_total,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa)%>% mutate(sede_cod='Ica')

pc_nd <- read.csv("pc_nd1.csv", header=TRUE) %>% dplyr::select(data_productividad_per,data_Tcamp ,
                                data_sumCOD,
                                data_sumHRSLB,
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_T_RangoEdad,
                                data_Testado_civil,
                                data_Tsexo,
                                data_T_numero_hijos,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_total,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa)%>% mutate(sede_cod='Piura')
pr_nd <- read.csv("pr_nd1.csv", header=TRUE)  %>% dplyr::select(data_productividad_per,data_Tcamp ,
                                data_sumCOD,
                                data_sumHRSLB,
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_T_RangoEdad,
                                data_Testado_civil,
                                data_Tsexo,
                                data_T_numero_hijos,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_total,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa)%>% mutate(sede_cod='Piura')
Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

df<-rbind(ic_nd,pc_nd) %>% mutate(data_T_RangoEdad=case_when(data_T_RangoEdad=='21-25'~'MENOR A 30',
                                        data_T_RangoEdad=='26-30'~'MENOR A 30',
                                        data_T_RangoEdad=='Menos de 20'~'MENOR A 30',
                                        data_T_RangoEdad=='31-35'~'DE 31 A 50',
                                        data_T_RangoEdad=='36-40'~'DE 31 A 50',
                                        data_T_RangoEdad=='41-50'~'DE 31 A 50',
                                        data_T_RangoEdad=='Màs de 50'~'MAS DE 50',
                                        TRUE ~ 'DE 31 A 50'))  %>% mutate(data_GRADO2=case_when(data_GRADO2=='SUPERIOR INCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='SUPERIOR COMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO IMCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO COMPLETA'~'SUPERIOR - TECNICO', TRUE ~ data_GRADO2
))

df1<-rbind(ir_nd,pr_nd) %>% mutate(data_T_RangoEdad=case_when(data_T_RangoEdad=='21-25'~'MENOR A 30',
                                        data_T_RangoEdad=='26-30'~'MENOR A 30',
                                        data_T_RangoEdad=='Menos de 20'~'MENOR A 30',
                                        data_T_RangoEdad=='31-35'~'DE 31 A 50',
                                        data_T_RangoEdad=='36-40'~'DE 31 A 50',
                                        data_T_RangoEdad=='41-50'~'DE 31 A 50',
                                        data_T_RangoEdad=='Màs de 50'~'MAS DE 50',
                                        TRUE ~ 'DE 31 A 50'))  %>% mutate(data_GRADO2=case_when(data_GRADO2=='SUPERIOR INCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='SUPERIOR COMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO IMCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO COMPLETA'~'SUPERIOR - TECNICO', TRUE ~ data_GRADO2
))

glimpse(df)

Rows: 22,079
Columns: 47
$ data_productividad_per              <dbl> 2.803874, 9.076923, 1.583333, 7.58…
$ data_Tcamp                          <int> 18, 19, 20, 18, 19, 20, 19, 18, 20…
$ data_sumCOD                         <int> 579, 59, 19, 91, 8, 401, 337, 380,…
$ data_sumHRSLB                       <dbl> 206.5, 6.5, 12.0, 12.0, 2.5, 158.0…
$ data_GRADO2                         <chr> "PRIMARIA COMPLETA", "SECUNDARIA C…
$ data_sum_variedad_total_AL          <dbl> 815.13, 0.00, 0.00, 0.00, 0.00, 40…
$ data_sum_variedad_total_CC          <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00…
$ data_sum_variedad_total_CP          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ data_sum_variedad_total_JS          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ data_sum_variedad_total_MG          <dbl> 400.80, 0.00, 0.00, 16.40, 0.00, 2…
$ data_sum_variedad_total_RG          <dbl> 0.00, 0.00, 36.18, 0.00, 0.00, 0.0…
$ data_sum_variedad_total_SG          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ data_sum_variedad_total_TC          <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00…
$ data_sum_variedad_total_TM          <dbl> 0.00, 35.07, 104.92, 0.00, 14.40, …
$ data_sum_variedad_total_VN          <dbl> 45.09, 0.00, 0.00, 0.00, 0.00, 0.0…
$ data_sum_aux_bono_total             <dbl> 324.66, 0.00, 2.06, 1.19, 0.00, 34…
$ data_sum_hora_extra                 <dbl> 70.25, 35.07, 0.00, 0.00, 14.40, 4…
$ data_n_lote                         <int> 5, 3, 2, 2, 1, 8, 7, 6, 3, 2, 2, 2…
$ data_n_fundo                        <int> 3, 1, 2, 2, 1, 4, 4, 3, 2, 1, 2, 1…
$ data_T_RangoEdad                    <chr> "MAS DE 50", "DE 31 A 50", "MAS DE…
$ data_Testado_civil                  <chr> "Casado(a)/conviviente/unionlibre"…
$ data_Tsexo                          <chr> "Hombre", "Mujer", "Hombre", "Homb…
$ data_T_numero_hijos                 <chr> "sin hijos", "sin hijos", "sin hij…
$ data_dias_empresa                   <int> 8068, 8104, 7731, 7731, 7261, 7366…
$ data_Tedad                          <dbl> 69, 45, 63, 60, 67, 55, 54, 53, 63…
$ data_numero_hijos                   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2…
$ data_pobreza                        <dbl> 41.25, 45.90, 45.90, 45.90, 45.90,…
$ data_n_variedad                     <int> 3, 1, 2, 2, 1, 3, 4, 3, 2, 1, 2, 1…
$ data_veces                          <int> 3, 1, 3, 3, 1, 4, 4, 4, 1, 2, 2, 2…
$ data_DEUDA_PROM_U6M                 <dbl> 12419.44, NA, NA, 1153.34, NA, 932…
$ data_PEOR_CALIF_U6M                 <chr> "2.DEFICIENTE", "8.SIN CALIFICACIO…
$ data_MODA_CALIF_U6M                 <chr> "0.NORMAL", NA, NA, "0.NORMAL", NA…
$ data_NRO_ENT_PROM_U6M               <dbl> 1.00, NA, NA, 1.00, NA, 1.00, 1.00…
$ data_TIPCRE_UM                      <chr> "CONSUMO NO REVOLVENTE", NA, NA, "…
$ data_DIAS_ATRASO_PROM_U6M           <dbl> 2.17, NA, NA, 0.00, NA, 0.00, 0.00…
$ data_BANCARIZADO                    <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
$ data_distancia                      <dbl> 2692.687, 4795.824, 4795.824, 4795…
$ data_import_unico                   <dbl> 893.80, 0.00, 141.10, 15.21, 0.00,…
$ data_total                          <dbl> 1288.71, 35.07, 143.16, 16.40, 14.…
$ data_bono_produc                    <dbl> 296.97, 0.00, 0.00, 1.19, 0.00, 11…
$ data_otros_bono                     <dbl> 27.69, 0.00, 2.06, 0.00, 0.00, 231…
$ dummies_Tsexo_Mujer                 <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ data_numero_asistentes              <int> 2, 3, 1, 2, 1, 3, 4, 1, 2, 1, 1, 1…
$ data_asistente_mediana_Tedad        <dbl> 32.0, 33.0, 35.0, NA, 49.0, 33.0, …
$ data_asistente_mediana_numero_hijos <dbl> 1.0, 2.0, 1.0, NA, 1.0, 0.0, 0.0, …
$ data_asistente_dias_empresa         <dbl> NA, NA, 2565, NA, 3627, NA, NA, NA…
$ sede_cod                            <chr> "Ica", "Ica", "Ica", "Ica", "Ica",…

COSECHA ICA Y PIURA

# BASE DE DATOS
#--------------
# SELECCIÓN DE VARIABLES
masterip_g1 <- df %>% dplyr::select(data_productividad_per,data_Tcamp,
                                data_sumCOD,
                                data_sumHRSLB,
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_T_RangoEdad,
                                data_Testado_civil,
                                data_Tsexo,
                                data_T_numero_hijos,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_total,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa)
                        
###############################################################################################
###################################### ANALISIS CLUSTER #######################################
###############################################################################################

masterip_g11 <- masterip_g1 %>% dplyr::select(data_productividad_per,
                                    data_bono_produc,
                                    data_otros_bono,
                                    data_import_unico,
                                    data_dias_empresa,
                                    data_Tedad,
                                    data_numero_hijos,
                                    data_pobreza,
                                    data_veces,
                                    dummies_Tsexo_Mujer,
                                    data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa
                                    )


masterip_g11 <- na.omit(masterip_g11)


masterip_g11 <- masterip_g1%>% dplyr::select(data_productividad_per,
                                    data_import_unico,
                                    data_dias_empresa,
                                    data_Tedad,
                                    data_numero_hijos,
                                    data_pobreza,
                                    data_veces,
                                    dummies_Tsexo_Mujer)


masterip_g11<-masterip_g11  %>% mutate_if(is.numeric, funs(replace(.,is.na(.), median(., na.rm = TRUE)))) %>% mutate_if(is.character, funs(replace(.,is.na(.), Mode(na.omit(.)))))
#######################################
# Cluster de Partición - No Jerárquicos
########################################

# Usando el criterio del Gráfico de Silueta
set.seed(123)
a<-fviz_nbclust(masterip_g11, FUNcluster = kmeans, method = "silhouette", k.max = 20) +
  labs(subtitle = "Silhouette method")
a
b<-a$data%>%slice(which.max(y))
b<-as.numeric(b[1,1])
paste("Numero de cluster=", b)
k <- b

set.seed(1234)
km <- kmeans(masterip_g11, k, iter.max = 1000, nstart=10)

paste("SS between cluster=", (km$betweens/km$totss) *100, "%")


# Para la validación de los cluster usamos Análisis discriminante

scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masterip_g11_final <- cbind(masterip_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masterip_g11_final)
n <- ncol(masterip_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masterip_g11_final[,-n])
#table(masterip_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masterip_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")

# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masterip_g11_final,ellipse.type = "convex") + 
  theme_classic()

corrplot(cor(masterip_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones


masterip_g11_final <- masterip_g11 %>% mutate(cluster=km$cluster )
masterip_g1$cluster <- masterip_g11_final$cluster

masterip_g1 %>% tab_cols(total(),cluster)  %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
  tab_stat_mean() %>%
  tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
  tab_stat_median() %>%
  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_cells('Bancarizado'=data_BANCARIZADO) %>%
  tab_stat_mean() %>%
  tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
  tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")



masterip_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>%  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")

Warning message:
“Quick-TRANSfer stage steps exceeded maximum (= 1103950)”
Warning message:
“Quick-TRANSfer stage steps exceeded maximum (= 1103950)”

'Numero de cluster= 3'

'SS between cluster= 72.9306007758425 %'

'Error de classification= 2.82168576475384 %'

Tabla describe cluster
			#Total		cluster
					1	2	3
Sede	#Total cases		22079		544	5747	15788
	Ica		60.9		71.0	70.7	57.0
	Piura		39.1		29.0	29.3	43.0
Productividad	Median		2.7		2.9	3.1	2.5
Producción	Median		276.0		74.0	999.0	129.0
Horas Laboraras	Median		101.0		26.0	314.5	54.0
Productividad	Max.		331.1		85.5	134.1	331.1
Producción	Max.		5657.0		3104.0	4697.0	5657.0
Horas Laboraras	Max.		711.8		641.5	711.8	626.2
Productividad	Min.		0.2		0.2	0.4	0.2
Producción	Min.		1.0		1.0	3.0	1.0
Horas Laboraras	Min.		0.5		1.0	4.0	0.5
Sexo	#Total cases		22079		544	5747	15788
	Hombre		35.5		59.6	17.1	41.4
	Mujer		64.5		40.4	82.9	58.6
Rango de edades	#Total cases		22079		544	5747	15788
	DE 31 A 50		43.3		71.7	51.9	39.1
	MAS DE 50		6.2		18.6	7.9	5.2
	MENOR A 30		50.5		9.7	40.2	55.7
Grado de Instruccion	#Total cases		17560		544	5016	12000
	ILETRADO		2.7		2.0	3.1	2.5
	PRIMARIA COMPLETA		13.8		17.8	14.6	13.2
	PRIMARIA INCOMPLETA		8.5		6.8	7.5	8.9
	SECUNDARIA COMPLETA		42.3		50.9	44.3	41.1
	SECUNDARIA IMCOMPLETA		30.7		16.2	28.5	32.3
	SUPERIOR - TECNICO		2.1		6.2	2.0	1.9
Estado Civil	#Total cases		22079		544	5747	15788
	Casado(a)/conviviente/unionlibre		8.0		20.2	9.0	7.2
	Divorciado(a)/separado(a)		0.1			0.1	0.1
	Soltero(a)		91.8		79.8	90.6	92.7
	Viudo(a)		0.1			0.2	0.1
Tenencia de Hijos	#Total cases		22079		544	5747	15788
	con hijos		55.3		32.4	71.0	50.4
	sin hijos		44.7		67.6	29.0	49.6
Cantidad de Campañas	#Total cases		22079		544	5747	15788
	1		52.8		16.2	29.5	62.6
	2		21.3		20.6	23.4	20.6
	3		11.9		21.5	18.6	9.2
	4		8.2		20.4	15.1	5.3
	5		5.7		21.3	13.3	2.4
Edad	Mean		32.2		41.5	34.3	31.0
Numero de hijos	Mean		0.8		0.5	1.0	0.7
Porcentaje de Pobreza	Mean		33.6		35.2	33.9	33.4
Dias en la Empresa	Mean		224.6		2921.1	165.3	153.2
Distancia que recorre en metros	Mean		93542.7		20357.6	65076.9	109076.5
Otros Bonos	Median		3.5		16.3	80.0	0.0
Numero de Lotes	Median		5.0		2.0	12.0	3.0
Numero de fundos	Median		2.0		2.0	4.0	2.0
Numero de variedad	Median		2.0		2.0	3.0	2.0
Importe unico	Mean		623.9		464.7	1518.2	303.9
Importe Horas extra	Mean		18.4		30.1	49.9	6.5
Bono total	Mean		178.6		175.9	473.1	71.5
Bono Produccion	Mean		126.5		133.1	362.7	40.3
Otros bonos	Mean		55.3		47.3	120.6	31.8
Bancarizado	Mean		0.7		0.9	0.7	0.7
Peor calificación	#Total cases		22074		544	5747	15783
	0.NORMAL		19.2		43.0	20.0	18.1
	1.CPP		3.7		5.0	4.3	3.4
	2.DEFICIENTE		1.6		2.0	1.5	1.5
	3.DUDOSO		2.3		2.9	2.7	2.1
	4.EN PERDIDA		21.7		17.3	19.4	22.8
	8.SIN CALIFICACION		51.5		29.8	52.1	52.0
Moda de Calificación	#Total cases		10648		375	2732	7541
	0.NORMAL		53.1		72.8	58.1	50.3
	1.CPP		2.1		1.6	2.0	2.1
	2.DEFICIENTE		1.0		1.1	1.1	0.9
	3.DUDOSO		2.8		2.1	2.9	2.7
	4.EN PERDIDA		41.1		22.4	35.9	43.9
data_TIPCRE_UM	#Total cases		7461		319	2007	5135
	CONSUMO NO REVOLVENTE		48.3		75.2	49.6	46.1
	CONSUMO REVOLVENTE		10.6		11.9	10.5	10.6
	HIPOTECARIOS PARA VIVIENDA		0.5		0.9	0.6	0.4
	MICROEMPRESAS		39.0		11.6	37.9	41.1
	PEQUENAS EMPRESAS		1.6		0.3	1.3	1.8
Deuda Promedio	Mean		4094.9		8033.5	4145.1	3848.5
Promedio de Dias de atraso	Mean		1.5		1.6	1.5	1.5
			66.7		62.4	69.8	65.8

Tabla describe cluster
			#Total		clus_camp
					1 - 18	1 - 19	1 - 20	2 - 18	2 - 19	2 - 20	3 - 18	3 - 19	3 - 20
Importe unico	Mean		623.9		471.2	475.2	442.9	1249.5	1615.8	1483.9	253.1	295.9	332.3
Importe Horas extra	Mean		18.4		36.1	29.2	27.1	72.7	45.2	46.6	11.2	6.4	4.8
Bono total	Mean		178.6		113.9	146.5	268.9	166.0	304.6	916.4	33.8	45.8	114.9
Bono Produccion	Mean		126.5		92.7	124.9	176.2	135.0	248.3	673.4	31.2	39.0	45.3
Otros bonos	Mean		55.3		21.2	25.4	101.6	31.1	62.0	266.3	2.7	7.3	70.7

# PARA 4 CLUSTERES
set.seed(1234)
km <- kmeans(masterip_g11, 4, iter.max = 1000, nstart=10)

paste("SS between cluster=", (km$betweens/km$totss) *100, "%")


# Para la validación de los cluster usamos Análisis discriminante

scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masterip_g11_final <- cbind(masterip_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masterip_g11_final)
n <- ncol(masterip_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masterip_g11_final[,-n])
#table(masterip_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masterip_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")

# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masterip_g11_final,ellipse.type = "convex") + 
  theme_classic()

corrplot(cor(masterip_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones


masterip_g11_final <- masterip_g11 %>% mutate(cluster=km$cluster )
masterip_g1$cluster <- masterip_g11_final$cluster


masterip_g1 %>% tab_cols(total(),cluster)  %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
  tab_stat_mean() %>%
  tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
  tab_stat_median() %>%
  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_cells('Bancarizado'=data_BANCARIZADO) %>%
  tab_stat_mean() %>%
  tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
  tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")



masterip_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>%  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")


write.csv(masterip_g1,'cosecha_base_clus_4clusteres.csv',row.names=FALSE)

'SS between cluster= 81.1891983773965 %'

'Error de classification= 4.38878572399112 %'

Tabla describe cluster
			#Total		cluster
					1	2	3	4
Sede	#Total cases		22079		3005	6019	12512	543
	Ica		60.9		73.1	57.6	59.1	70.9
	Piura		39.1		26.9	42.4	40.9	29.1
Productividad	Median		2.7		3.3	2.9	2.3	2.9
Producción	Median		276.0		1235.0	595.0	78.0	74.0
Horas Laboraras	Median		101.0		364.5	203.5	34.5	26.0
Productividad	Max.		331.1		12.5	134.1	331.1	85.5
Producción	Max.		5657.0		4697.0	3246.0	5657.0	3104.0
Horas Laboraras	Max.		711.8		711.8	624.5	626.2	641.5
Productividad	Min.		0.2		0.9	0.4	0.2	0.2
Producción	Min.		1.0		5.0	3.0	1.0	1.0
Horas Laboraras	Min.		0.5		4.0	5.0	0.5	1.0
Sexo	#Total cases		22079		3005	6019	12512	543
	Hombre		35.5		13.5	25.0	44.9	59.7
	Mujer		64.5		86.5	75.0	55.1	40.3
Rango de edades	#Total cases		22079		3005	6019	12512	543
	DE 31 A 50		43.3		55.1	46.9	37.5	71.6
	MAS DE 50		6.2		8.7	6.0	5.2	18.6
	MENOR A 30		50.5		36.3	47.1	57.3	9.8
Grado de Instruccion	#Total cases		17560		2674	4976	9367	543
	ILETRADO		2.7		3.0	3.1	2.4	2.0
	PRIMARIA COMPLETA		13.8		15.3	14.6	12.7	17.9
	PRIMARIA INCOMPLETA		8.5		7.8	8.8	8.6	6.8
	SECUNDARIA COMPLETA		42.3		45.0	41.5	41.4	51.0
	SECUNDARIA IMCOMPLETA		30.7		26.7	30.1	33.1	16.0
	SUPERIOR - TECNICO		2.1		2.2	1.9	1.8	6.3
Estado Civil	#Total cases		22079		3005	6019	12512	543
	Casado(a)/conviviente/unionlibre		8.0		9.2	8.4	7.0	20.3
	Divorciado(a)/separado(a)		0.1		0.2	0.1	0.1
	Soltero(a)		91.8		90.4	91.4	92.9	79.7
	Viudo(a)		0.1		0.2	0.1	0.1
Tenencia de Hijos	#Total cases		22079		3005	6019	12512	543
	con hijos		55.3		73.9	65.2	47.1	32.4
	sin hijos		44.7		26.1	34.8	52.9	67.6
Cantidad de Campañas	#Total cases		22079		3005	6019	12512	543
	1		52.8		23.0	46.8	64.5	16.2
	2		21.3		23.6	22.6	20.2	20.6
	3		11.9		19.8	14.0	8.6	21.4
	4		8.2		16.8	9.6	4.9	20.4
	5		5.7		16.7	7.0	1.8	21.4
Edad	Mean		32.2		35.1	32.8	30.7	41.5
Numero de hijos	Mean		0.8		1.1	0.9	0.6	0.5
Porcentaje de Pobreza	Mean		33.6		33.9	33.6	33.4	35.2
Dias en la Empresa	Mean		224.6		178.8	144.0	157.3	2922.4
Distancia que recorre en metros	Mean		93542.7		57677.6	84345.1	113179.3	20390.5
Otros Bonos	Median		3.5		109.8	41.4	0.0	16.0
Numero de Lotes	Median		5.0		14.0	9.0	2.0	2.0
Numero de fundos	Median		2.0		4.0	3.0	1.0	2.0
Numero de variedad	Median		2.0		4.0	3.0	1.0	2.0
Importe unico	Mean		623.9		1862.6	908.1	196.9	460.8
Importe Horas extra	Mean		18.4		63.0	24.1	4.4	30.1
Bono total	Mean		178.6		625.6	239.0	42.4	172.6
Bono Produccion	Mean		126.5		489.9	158.5	23.8	129.9
Otros bonos	Mean		55.3		150.6	83.5	19.2	47.1
Bancarizado	Mean		0.7		0.7	0.7	0.7	0.9
Peor calificación	#Total cases		22074		3005	6019	12507	543
	0.NORMAL		19.2		20.6	18.6	18.2	42.9
	1.CPP		3.7		4.1	4.2	3.3	5.0
	2.DEFICIENTE		1.6		1.8	1.3	1.6	2.0
	3.DUDOSO		2.3		2.9	2.2	2.2	2.9
	4.EN PERDIDA		21.7		18.0	22.6	22.5	17.3
	8.SIN CALIFICACION		51.5		52.7	51.1	52.3	29.8
Moda de Calificación	#Total cases		10648		1411	2924	5939	374
	0.NORMAL		53.1		60.0	52.3	50.6	72.7
	1.CPP		2.1		1.7	2.2	2.1	1.6
	2.DEFICIENTE		1.0		1.3	1.0	0.9	1.1
	3.DUDOSO		2.8		2.8	2.8	2.7	2.1
	4.EN PERDIDA		41.1		34.2	41.7	43.6	22.5
data_TIPCRE_UM	#Total cases		7461		1057	2035	4051	318
	CONSUMO NO REVOLVENTE		48.3		52.8	44.3	47.0	75.2
	CONSUMO REVOLVENTE		10.6		10.9	9.9	10.8	11.9
	HIPOTECARIOS PARA VIVIENDA		0.5		0.5	0.5	0.5	0.9
	MICROEMPRESAS		39.0		34.3	43.5	40.1	11.6
	PEQUENAS EMPRESAS		1.6		1.5	1.8	1.6	0.3
Deuda Promedio	Mean		4094.9		4439.6	3868.8	3832.9	8020.4
Promedio de Dias de atraso	Mean		1.5		1.5	1.5	1.5	1.6
			66.7		65.2	70.5	65.5	62.6

Tabla describe cluster
			#Total		clus_camp
					1 - 18	1 - 19	1 - 20	2 - 18	2 - 19	2 - 20	3 - 18	3 - 19	3 - 20	4 - 18	4 - 19	4 - 20
Importe unico	Mean		623.9		1449.4	1963.2	1786.0	990.0	920.6	855.0	155.5	191.3	220.2	471.2	467.3	442.9
Importe Horas extra	Mean		18.4		101.0	60.8	57.1	50.1	18.3	19.0	6.6	4.8	3.1	36.1	29.3	27.1
Bono total	Mean		178.6		219.7	368.3	1202.5	130.8	161.9	381.6	17.8	30.0	67.2	113.9	139.5	268.9
Bono Produccion	Mean		126.5		161.9	297.3	927.9	115.8	133.3	208.5	16.0	26.8	23.3	92.7	118.3	176.2
Otros bonos	Mean		55.3		57.9	78.6	306.5	15.0	30.3	179.0	1.8	3.6	44.8	21.2	24.9	101.6

# Para 5 Clusteres
set.seed(1234)
km <- kmeans(masterip_g11, 5, iter.max = 1000, nstart=10)

paste("SS between cluster=", (km$betweens/km$totss) *100, "%")


# Para la validación de los cluster usamos Análisis discriminante

scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masterip_g11_final <- cbind(masterip_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masterip_g11_final)
n <- ncol(masterip_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masterip_g11_final[,-n])
#table(masterip_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masterip_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")

# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masterip_g11_final,ellipse.type = "convex") + 
  theme_classic()

corrplot(cor(masterip_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones


masterip_g11_final <- masterip_g11 %>% mutate(cluster=km$cluster )
masterip_g1$cluster <- masterip_g11_final$cluster


masterip_g1 %>% tab_cols(total(),cluster)  %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
  tab_stat_mean() %>%
  tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
  tab_stat_median() %>%
  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_cells('Bancarizado'=data_BANCARIZADO) %>%
  tab_stat_mean() %>%
  tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
  tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")



masterip_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>%  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")

write.csv(masterip_g1,'cosecha_base_clus_5clusteres.csv',row.names=FALSE)

'SS between cluster= 84.938304926303 %'

'Error de classification= 4.47484034603016 %'

Tabla describe cluster
			#Total		cluster
					1	2	3	4	5
Sede	#Total cases		22079		5931	12396	249	2973	530
	Ica		60.9		57.8	59.0	70.3	73.0	67.7
	Piura		39.1		42.2	41.0	29.7	27.0	32.3
Productividad	Median		2.7		2.9	2.3	2.9	3.3	2.9
Producción	Median		276.0		601.0	81.0	88.0	1235.0	60.5
Horas Laboraras	Median		101.0		205.8	35.5	27.5	365.0	22.0
Productividad	Max.		331.1		134.1	331.1	10.0	12.5	85.5
Producción	Max.		5657.0		3246.0	5657.0	3104.0	4697.0	3072.0
Horas Laboraras	Max.		711.8		624.5	626.2	641.5	711.8	596.0
Productividad	Min.		0.2		0.4	0.2	0.5	0.9	0.2
Producción	Min.		1.0		3.0	1.0	1.0	5.0	2.0
Horas Laboraras	Min.		0.5		5.0	0.5	1.0	4.0	1.0
Sexo	#Total cases		22079		5931	12396	249	2973	530
	Hombre		35.5		24.9	44.9	67.1	13.5	45.1
	Mujer		64.5		75.1	55.1	32.9	86.5	54.9
Rango de edades	#Total cases		22079		5931	12396	249	2973	530
	DE 31 A 50		43.3		47.0	37.1	69.1	55.1	68.7
	MAS DE 50		6.2		6.0	5.2	26.5	8.7	8.5
	MENOR A 30		50.5		47.0	57.7	4.4	36.3	22.8
Grado de Instruccion	#Total cases		17560		4905	9238	249	2645	523
	ILETRADO		2.7		3.1	2.4	3.2	3.1	1.1
	PRIMARIA COMPLETA		13.8		14.6	12.7	19.3	15.4	14.5
	PRIMARIA INCOMPLETA		8.5		8.8	8.7	7.2	7.8	5.4
	SECUNDARIA COMPLETA		42.3		41.5	41.4	53.0	44.8	48.0
	SECUNDARIA IMCOMPLETA		30.7		30.0	33.1	11.2	26.7	26.2
	SUPERIOR - TECNICO		2.1		1.9	1.8	6.0	2.3	4.8
Estado Civil	#Total cases		22079		5931	12396	249	2973	530
	Casado(a)/conviviente/unionlibre		8.0		8.4	6.8	28.1	9.2	14.9
	Divorciado(a)/separado(a)		0.1		0.1	0.1		0.2
	Soltero(a)		91.8		91.4	93.0	71.9	90.4	85.1
	Viudo(a)		0.1		0.1	0.1		0.2
Tenencia de Hijos	#Total cases		22079		5931	12396	249	2973	530
	con hijos		55.3		65.5	47.3	24.9	73.9	37.9
	sin hijos		44.7		34.5	52.7	75.1	26.1	62.1
Cantidad de Campañas	#Total cases		22079		5931	12396	249	2973	530
	1		52.8		46.7	65.2	21.7	23.2	12.6
	2		21.3		22.7	20.3	21.3	23.6	17.5
	3		11.9		14.2	8.2	19.7	19.7	26.4
	4		8.2		9.5	4.6	17.7	16.8	26.0
	5		5.7		7.0	1.7	19.7	16.7	17.4
Edad	Mean		32.2		32.9	30.6	43.9	35.1	37.4
Numero de hijos	Mean		0.8		0.9	0.6	0.4	1.1	0.6
Porcentaje de Pobreza	Mean		33.6		33.6	33.4	33.4	33.9	36.2
Dias en la Empresa	Mean		224.6		138.7	139.8	3839.2	176.8	1737.2
Distancia que recorre en metros	Mean		93542.7		83849.8	114424.4	11595.9	57905.3	40458.9
Otros Bonos	Median		3.5		41.4	0.0	15.8	109.8	12.8
Numero de Lotes	Median		5.0		9.0	3.0	2.0	14.0	2.0
Numero de fundos	Median		2.0		3.0	1.0	2.0	4.0	2.0
Numero de variedad	Median		2.0		3.0	1.0	1.0	4.0	1.5
Importe unico	Mean		623.9		915.6	200.1	494.7	1867.5	359.5
Importe Horas extra	Mean		18.4		24.3	4.3	33.8	63.1	23.2
Bono total	Mean		178.6		240.7	43.1	190.3	627.0	131.2
Bono Produccion	Mean		126.5		159.9	24.2	144.0	490.9	95.1
Otros bonos	Mean		55.3		83.8	19.4	51.7	151.1	39.1
Bancarizado	Mean		0.7		0.7	0.7	0.9	0.7	0.9
Peor calificación	#Total cases		22074		5931	12391	249	2973	530
	0.NORMAL		19.2		18.4	18.0	45.4	20.5	37.2
	1.CPP		3.7		4.3	3.3	5.2	4.1	4.0
	2.DEFICIENTE		1.6		1.3	1.6	1.6	1.8	2.5
	3.DUDOSO		2.3		2.2	2.2	4.0	2.9	1.9
	4.EN PERDIDA		21.7		22.6	22.4	17.3	17.9	20.0
	8.SIN CALIFICACION		51.5		51.2	52.6	26.5	52.9	34.5
Moda de Calificación	#Total cases		10648		2878	5856	181	1392	341
	0.NORMAL		53.1		52.0	50.3	73.5	60.1	70.1
	1.CPP		2.1		2.2	2.1	1.1	1.7	2.3
	2.DEFICIENTE		1.0		1.0	0.9	1.1	1.3	1.2
	3.DUDOSO		2.8		2.9	2.8	2.2	2.8	1.2
	4.EN PERDIDA		41.1		41.9	43.8	22.1	34.1	25.2
data_TIPCRE_UM	#Total cases		7461		1999	3981	155	1045	281
	CONSUMO NO REVOLVENTE		48.3		44.3	46.4	80.0	52.4	70.8
	CONSUMO REVOLVENTE		10.6		9.7	10.7	11.6	11.0	14.2
	HIPOTECARIOS PARA VIVIENDA		0.5		0.6	0.5		0.5	1.1
	MICROEMPRESAS		39.0		43.6	40.9	8.4	34.5	12.8
	PEQUENAS EMPRESAS		1.6		1.8	1.6		1.5	1.1
Deuda Promedio	Mean		4094.9		3865.6	3783.3	8211.8	4463.4	6859.2
Promedio de Dias de atraso	Mean		1.5		1.5	1.5	1.5	1.5	1.7
			66.7		70.8	66.6	24.6	65.1	66.5

Tabla describe cluster
			#Total		clus_camp
					1 - 18	1 - 19	1 - 20	2 - 18	2 - 19	2 - 20	3 - 18	3 - 19	3 - 20	4 - 18	4 - 19	4 - 20	5 - 18	5 - 19	5 - 20
Importe unico	Mean		623.9		1001.2	927.8	860.7	159.6	194.2	223.2	506.8	479.5	510.5	1452.7	1966.7	1788.7	351.0	363.6	359.7
Importe Horas extra	Mean		18.4		50.5	18.4	19.2	6.7	4.6	3.0	37.6	35.7	28.4	102.8	61.0	57.2	27.7	20.6	23.6
Bono total	Mean		178.6		131.8	164.0	383.7	18.0	30.2	68.3	110.3	143.7	316.5	220.4	368.8	1202.2	87.7	92.8	236.6
Bono Produccion	Mean		126.5		116.3	135.0	210.1	16.5	27.2	23.7	88.6	119.3	219.5	162.3	297.7	927.1	70.5	74.2	153.3
Otros bonos	Mean		55.3		15.6	30.6	179.7	1.6	3.5	45.5	21.7	28.3	108.2	58.3	78.8	306.8	17.2	20.9	90.3

ARBOL DE CLASIFICACIÓN

library(rpart)
library(rpart.plot)
library(caret)
library(partykit)

Loading required package: lattice


Attaching package: ‘caret’


The following object is masked from ‘package:purrr’:

    lift


Loading required package: grid

Loading required package: libcoin

Loading required package: mvtnorm

masterip_g1<-masterip_g1 %>%  mutate(q1 = ntile(data_productividad_per,3))  %>% mutate(productividad_cat=case_when(q1=='1'~'BAJO',q1=='2'~'MEDIO',q1=='3'~'ALTO',TRUE ~ 'OTRO')) %>% dplyr::select(-q1)

masterip_g14<-masterip_g1%>% dplyr::select(
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_Testado_civil,
                                data_Tsexo,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa,cluster,productividad_cat)

####################################################
# ÁRBOL DE CLASIFICACIÓN CON EL ALGORITMO CART     #
####################################################


set.seed(123)
arbol_1 <- rpart(factor(productividad_cat)~., 
                 data=masterip_g14, 
                 method="class",
                 parms=list(split='gini'))

#Graficando el árbol

rpart.plot(arbol_1, digits=-1, type=0, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=1, extra=106,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=2, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=3, extra=105,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=4, extra=105,cex = .7, nn=TRUE)

#library(caret)
#varImp(arbol_1)

# Mejorando los Gráficos


plot(as.party(arbol_1), tp_args = list(id = FALSE))


####################################################
# CART CON CARET Y VALIDACIÓN CRUZADA REPETIDA  #
####################################################

Warning message:
“extra=106 but the response has 3 levels (only the 2nd level is displayed)”

####################################################
# CART CON CARET Y VALIDACIÓN CRUZADA REPETIDA  #
####################################################
names(getModelInfo())

#Relación de parámetros a ajustar de un modelo
modelLookup(model='rpart')


# Aplicando el modelo con Validación Cruzada Repetida 
ctrl <- trainControl(method="repeatedcv", repeats = 5, number=2)

df_dep1 <- na.omit(masterip_g14)
set.seed(123)
modelo_cart_1 <- train(factor(productividad_cat)~., 
                 data=masterip_g14, 
                       method = "rpart",
                       trControl = ctrl, 
                       tuneLength = 20, 
                       metric="Accuracy")

modelo_cart_1
varImp(modelo_cart_1)

RALEO ICA Y PIURA - G1

# BASE DE DATOS
#--------------
# SELECCIÓN DE VARIABLES
masteripr_g1 <- df1 %>% dplyr::select(data_productividad_per,data_Tcamp ,
                                data_sumCOD,
                                data_sumHRSLB,
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_T_RangoEdad,
                                data_Testado_civil,
                                data_Tsexo,
                                data_T_numero_hijos,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_total,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa)
                        
###############################################################################################
###################################### ANALISIS CLUSTER #######################################
###############################################################################################

masteripr_g11 <- masteripr_g1 %>% dplyr::select(data_productividad_per,
                                    data_bono_produc,
                                    data_otros_bono,
                                    data_import_unico,
                                    data_dias_empresa,
                                    data_Tedad,
                                    data_numero_hijos,
                                    data_pobreza,
                                    data_veces,
                                    dummies_Tsexo_Mujer,
                                    data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa
                                    )


masteripr_g11 <- na.omit(masteripr_g11)


masteripr_g11 <- masteripr_g1 %>% dplyr::select(data_productividad_per,
                                    data_import_unico,
                                    data_dias_empresa,
                                    data_Tedad,
                                    data_numero_hijos,
                                    data_pobreza,
                                    data_veces,
                                    dummies_Tsexo_Mujer)


#######################################
# Cluster de Partición - No Jerárquicos
########################################

# Usando el criterio del Gráfico de Silueta
set.seed(123)
a<-fviz_nbclust(masteripr_g11, FUNcluster = kmeans, method = "silhouette", k.max = 20) +
  labs(subtitle = "Silhouette method")
a
b<-a$data%>%slice(which.max(y))
b<-as.numeric(b[1,1])
paste("Numero de cluster=", b)
k <- b

set.seed(1234)
km <- kmeans(masteripr_g11, k, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")


# Para la validación de los cluster usamos Análisis discriminante

scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masteripr_g11_final <- cbind(masteripr_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masteripr_g11_final)
n <- ncol(masteripr_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masteripr_g11_final[,-n])
#table(masteripr_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masteripr_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")

# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masteripr_g11_final,ellipse.type = "convex") + 
  theme_classic()

corrplot(cor(masteripr_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones


masteripr_g11_final <- masteripr_g11 %>% mutate(cluster=km$cluster )
masteripr_g1$cluster <- masteripr_g11_final$cluster


masteripr_g1 %>% tab_cols(total(),cluster)  %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
  tab_stat_mean() %>%
  tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
  tab_stat_median() %>%
  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_cells('Bancarizado'=data_BANCARIZADO) %>%
  tab_stat_mean() %>%
  tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
  tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")



masteripr_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>%  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")

Warning message:
“Quick-TRANSfer stage steps exceeded maximum (= 1155750)”
Warning message:
“did not converge in 10 iterations”

'Numero de cluster= 3'

'SS between cluster= 74.3529242654961 %'

'Error de classification= 2.50486696950032 %'

Tabla describe cluster
			#Total		cluster
					1	2	3
Sede	#Total cases		23115		573	16459	6083
	Ica		45.1		70.3	46.7	38.6
	Piura		54.9		29.7	53.3	61.4
Productividad	Median		22.7		33.9	18.9	34.9
Producción	Median		788.0		815.0	380.0	10289.0
Horas Laboraras	Median		76.5		45.0	39.2	301.0
Productividad	Max.		238.5		149.3	238.5	224.1
Producción	Max.		96681.0		40975.0	46374.0	96681.0
Horas Laboraras	Max.		836.5		580.5	348.0	836.5
Productividad	Min.		0.1		0.4	0.1	0.3
Producción	Min.		1.0		3.0	1.0	4.0
Horas Laboraras	Min.		0.2		2.0	0.2	8.0
Sexo	#Total cases		23115		573	16459	6083
	Hombre		46.2		58.3	47.5	41.6
	Mujer		53.8		41.7	52.5	58.4
Rango de edades	#Total cases		23115		573	16459	6083
	DE 31 A 50		44.0		74.2	41.4	48.2
	MAS DE 50		4.7		13.6	4.5	4.3
	MENOR A 30		51.3		12.2	54.1	47.5
Grado de Instruccion	#Total cases		18840		573	13107	5160
	EDUCACION ESPECIAL		0.0			0.0
	ILETRADO		2.5		1.9	2.2	3.2
	PRIMARIA COMPLETA		14.4		17.1	13.3	17.0
	PRIMARIA INCOMPLETA		9.7		6.1	8.7	12.5
	SECUNDARIA COMPLETA		40.8		49.9	41.9	37.2
	SECUNDARIA IMCOMPLETA		31.0		19.2	32.4	28.7
	SUPERIOR - TECNICO		1.6		5.8	1.5	1.4
Estado Civil	#Total cases		23115		573	16459	6083
	Casado(a)/conviviente/unionlibre		7.9		20.8	6.8	9.7
	Divorciado(a)/separado(a)		0.1			0.1	0.1
	Soltero(a)		91.9		79.2	93.0	90.1
	Viudo(a)		0.1			0.1	0.2
Tenencia de Hijos	#Total cases		23115		573	16459	6083
	con hijos		52.1		26.0	46.8	68.8
	sin hijos		47.9		74.0	53.2	31.2
Cantidad de Campañas	#Total cases		23115		573	16459	6083
	1		51.9		4.0	61.2	31.4
	2		22.9		8.2	21.6	28.0
	3		11.5		14.8	8.5	19.5
	4		7.9		27.2	5.3	12.9
	5		5.7		45.7	3.4	8.2
Edad	Mean		31.8		40.3	31.3	32.3
Numero de hijos	Mean		0.7		0.4	0.6	1.0
Porcentaje de Pobreza	Mean		32.8		34.8	32.8	32.7
Dias en la Empresa	Mean		257.5		2981.2	180.4	209.3
Distancia que recorre en metros	Mean		94220.0		18581.8	108558.9	66591.0
Otros Bonos	Median		0.0		1.3	0.0	0.0
Numero de Lotes	Median		4.0		3.0	2.0	12.0
Numero de fundos	Median		2.0		2.0	1.0	3.0
Numero de variedad	Median		2.0		1.0	1.0	3.0
Importe unico	Mean		545.1		402.0	249.0	1359.8
Importe Horas extra	Mean		9.8		28.3	6.1	18.1
Bono total	Mean		315.3		190.2	137.9	807.2
Bono Produccion	Mean		262.5		181.9	110.4	681.5
Otros bonos	Mean		1.4		18.0	1.1	0.8
Bancarizado	Mean		0.7		0.9	0.7	0.8
Peor calificación	#Total cases		23112		573	16456	6083
	0.NORMAL		21.0		46.4	19.6	22.3
	1.CPP		4.0		4.4	4.0	3.8
	2.DEFICIENTE		1.8		2.1	1.9	1.7
	3.DUDOSO		2.6		1.9	2.6	2.8
	4.EN PERDIDA		23.5		16.4	24.4	21.8
	8.SIN CALIFICACION		47.0		28.8	47.4	47.7
Moda de Calificación	#Total cases		12191		406	8612	3173
	0.NORMAL		52.7		75.6	50.1	56.8
	1.CPP		2.2		2.0	2.3	1.9
	2.DEFICIENTE		1.3		0.5	1.4	1.3
	3.DUDOSO		3.5		2.2	3.8	2.9
	4.EN PERDIDA		40.3		19.7	42.5	37.1
data_TIPCRE_UM	#Total cases		8528		347	5902	2279
	CONSUMO NO REVOLVENTE		49.5		76.7	48.2	48.7
	CONSUMO REVOLVENTE		10.8		14.1	10.9	10.0
	HIPOTECARIOS PARA VIVIENDA		0.4		0.3	0.5	0.2
	MICROEMPRESAS		37.8		8.4	38.8	39.8
	PEQUENAS EMPRESAS		1.5		0.6	1.6	1.3
Deuda Promedio	Mean		4033.0		7702.3	3881.2	3887.8
Promedio de Dias de atraso	Mean		1.5		1.6	1.5	1.5
			62.2		70.3	63.3	57.9

Tabla describe cluster
			#Total		clus_camp
					1 - 19	1 - 20	2 - 19	2 - 20	3 - 19	3 - 20
Importe unico	Mean		545.1		446.2	349.9	265.5	233.3	1400.0	1306.1
Importe Horas extra	Mean		9.8		16.1	42.7	4.7	7.4	17.7	18.5
Bono total	Mean		315.3		181.3	200.6	135.2	140.5	752.8	880.0
Bono Produccion	Mean		262.5		159.6	208.1	91.8	128.0	647.6	726.9
Otros bonos	Mean		1.4		21.6	13.8	0.9	1.2	0.9	0.7

# CON 4 CLUSTERES

set.seed(1234)
km <- kmeans(masteripr_g11, 4, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")


# Para la validación de los cluster usamos Análisis discriminante

scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masteripr_g11_final <- cbind(masteripr_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masteripr_g11_final)
n <- ncol(masteripr_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masteripr_g11_final[,-n])
#table(masteripr_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masteripr_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")

# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masteripr_g11_final,ellipse.type = "convex") + 
  theme_classic()

corrplot(cor(masteripr_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones


masteripr_g11_final <- masteripr_g11 %>% mutate(cluster=km$cluster )
masteripr_g1$cluster <- masteripr_g11_final$cluster

masteripr_g1 %>% tab_cols(total(),cluster)  %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
  tab_stat_mean() %>%
  tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
  tab_stat_median() %>%
  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_cells('Bancarizado'=data_BANCARIZADO) %>%
  tab_stat_mean() %>%
  tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
  tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")



masteripr_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>%  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")

write.csv(masteripr_g1,'raleo_base_clus_4clusteres.csv',row.names=FALSE)

'SS between cluster= 81.9386977118233 %'

'Error de classification= 3.14947004109885 %'

Tabla describe cluster
			#Total		cluster
					1	2	3	4
Sede	#Total cases		23115		573	5793	3247	13502
	Ica		45.1		70.3	47.2	32.3	46.2
	Piura		54.9		29.7	52.8	67.7	53.8
Productividad	Median		22.7		33.9	33.7	34.6	16.4
Producción	Median		788.0		815.0	6332.0	13052.0	266.0
Horas Laboraras	Median		76.5		45.0	187.8	375.5	27.2
Productividad	Max.		238.5		149.3	224.1	203.6	238.5
Producción	Max.		96681.0		40975.0	58406.0	96681.0	25096.0
Horas Laboraras	Max.		836.5		580.5	494.0	836.5	251.5
Productividad	Min.		0.1		0.4	0.3	0.5	0.1
Producción	Min.		1.0		3.0	4.0	73.0	1.0
Horas Laboraras	Min.		0.2		2.0	8.0	61.5	0.2
Sexo	#Total cases		23115		573	5793	3247	13502
	Hombre		46.2		58.3	41.0	41.6	49.0
	Mujer		53.8		41.7	59.0	58.4	51.0
Rango de edades	#Total cases		23115		573	5793	3247	13502
	DE 31 A 50		44.0		74.2	46.6	48.5	40.5
	MAS DE 50		4.7		13.6	4.6	4.5	4.4
	MENOR A 30		51.3		12.2	48.9	47.0	55.1
Grado de Instruccion	#Total cases		18840		573	4909	2738	10620
	EDUCACION ESPECIAL		0.0					0.0
	ILETRADO		2.5		1.9	2.1	4.3	2.2
	PRIMARIA COMPLETA		14.4		17.1	14.4	18.7	13.2
	PRIMARIA INCOMPLETA		9.7		6.1	10.3	13.5	8.6
	SECUNDARIA COMPLETA		40.8		49.9	40.7	34.8	41.9
	SECUNDARIA IMCOMPLETA		31.0		19.2	30.9	27.6	32.5
	SUPERIOR - TECNICO		1.6		5.8	1.5	1.1	1.6
Estado Civil	#Total cases		23115		573	5793	3247	13502
	Casado(a)/conviviente/unionlibre		7.9		20.8	7.9	10.4	6.7
	Divorciado(a)/separado(a)		0.1			0.1	0.1	0.1
	Soltero(a)		91.9		79.2	91.9	89.3	93.1
	Viudo(a)		0.1			0.1	0.2	0.1
Tenencia de Hijos	#Total cases		23115		573	5793	3247	13502
	con hijos		52.1		26.0	63.9	70.9	43.5
	sin hijos		47.9		74.0	36.1	29.1	56.5
Cantidad de Campañas	#Total cases		23115		573	5793	3247	13502
	1		51.9		4.0	41.5	26.2	64.6
	2		22.9		8.2	26.1	28.4	20.9
	3		11.5		14.8	15.3	21.0	7.5
	4		7.9		27.2	10.1	14.6	4.5
	5		5.7		45.7	7.0	9.8	2.5
Edad	Mean		31.8		40.3	32.2	32.4	31.0
Numero de hijos	Mean		0.7		0.4	0.9	1.0	0.6
Porcentaje de Pobreza	Mean		32.8		34.8	33.3	32.4	32.6
Dias en la Empresa	Mean		257.5		2981.2	186.6	225.9	179.9
Distancia que recorre en metros	Mean		94220.0		18581.8	81017.9	58630.7	113818.6
Otros Bonos	Median		0.0		1.3	0.0	0.0	0.0
Numero de Lotes	Median		4.0		3.0	8.0	16.0	2.0
Numero de fundos	Median		2.0		2.0	3.0	4.0	1.0
Numero de variedad	Median		2.0		1.0	3.0	4.0	1.0
Importe unico	Mean		545.1		402.0	825.2	1662.2	162.3
Importe Horas extra	Mean		9.8		28.3	16.4	18.1	4.2
Bono total	Mean		315.3		190.2	555.0	893.4	78.8
Bono Produccion	Mean		262.5		181.9	473.9	744.1	59.3
Otros bonos	Mean		1.4		18.0	1.3	0.6	0.9
Bancarizado	Mean		0.7		0.9	0.8	0.8	0.7
Peor calificación	#Total cases		23112		573	5793	3247	13499
	0.NORMAL		21.0		46.4	21.5	23.0	19.2
	1.CPP		4.0		4.4	4.2	3.5	4.0
	2.DEFICIENTE		1.8		2.1	1.9	1.8	1.8
	3.DUDOSO		2.6		1.9	2.7	2.7	2.6
	4.EN PERDIDA		23.5		16.4	23.0	20.5	24.8
	8.SIN CALIFICACION		47.0		28.8	46.7	48.4	47.6
Moda de Calificación	#Total cases		12191		406	3071	1670	7044
	0.NORMAL		52.7		75.6	54.1	59.1	49.2
	1.CPP		2.2		2.0	2.0	1.9	2.4
	2.DEFICIENTE		1.3		0.5	1.6	1.0	1.3
	3.DUDOSO		3.5		2.2	3.3	2.7	3.9
	4.EN PERDIDA		40.3		19.7	39.1	35.3	43.2
data_TIPCRE_UM	#Total cases		8528		347	2199	1206	4776
	CONSUMO NO REVOLVENTE		49.5		76.7	48.7	49.3	48.0
	CONSUMO REVOLVENTE		10.8		14.1	10.6	9.5	11.0
	HIPOTECARIOS PARA VIVIENDA		0.4		0.3	0.5		0.5
	MICROEMPRESAS		37.8		8.4	39.0	39.6	39.0
	PEQUENAS EMPRESAS		1.5		0.6	1.3	1.6	1.6
Deuda Promedio	Mean		4033.0		7702.3	4018.0	3694.2	3868.7
Promedio de Dias de atraso	Mean		1.5		1.6	1.5	1.4	1.5
			62.2		70.3	72.2	49.3	60.2

Tabla describe cluster
			#Total		clus_camp
					1 - 19	1 - 20	2 - 19	2 - 20	3 - 19	3 - 20	4 - 19	4 - 20
Importe unico	Mean		545.1		446.2	349.9	830.5	819.3	1699.1	1606.9	179.9	146.0
Importe Horas extra	Mean		9.8		16.1	42.7	12.8	20.4	19.7	15.7	3.4	4.9
Bono total	Mean		315.3		181.3	200.6	467.7	650.9	882.0	910.7	87.1	71.1
Bono Produccion	Mean		262.5		159.6	208.1	353.9	605.6	795.7	666.8	56.2	62.2
Otros bonos	Mean		1.4		21.6	13.8	1.1	1.5	0.9	0.3	0.9	1.0

# CON 5 CLUSTERES

set.seed(1234)
km <- kmeans(masteripr_g11, 5, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")


# Para la validación de los cluster usamos Análisis discriminante

scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masteripr_g11_final <- cbind(masteripr_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masteripr_g11_final)
n <- ncol(masteripr_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masteripr_g11_final[,-n])
#table(masteripr_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masteripr_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")

# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masteripr_g11_final,ellipse.type = "convex") + 
  theme_classic()

corrplot(cor(masteripr_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones


masteripr_g11_final <- masteripr_g11 %>% mutate(cluster=km$cluster )
masteripr_g1$cluster <- masteripr_g11_final$cluster

masteripr_g1 %>% tab_cols(total(),cluster)  %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
  tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
  tab_stat_mean() %>%
  tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
  tab_stat_median() %>%
  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_cells('Bancarizado'=data_BANCARIZADO) %>%
  tab_stat_mean() %>%
  tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
  tab_stat_cpct(total_row_position = "above") %>%
  tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")



masteripr_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>%  tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
            'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
  tab_stat_mean() %>%
  tab_pivot() %>% 
  set_caption("Tabla describe cluster")

write.csv(masteripr_g1,'raleo_base_clus_5clusteres.csv',row.names=FALSE)

'SS between cluster= 85.7511707463826 %'

'Error de classification= 3.21868916288125 %'

Tabla describe cluster
			#Total		cluster
					1	2	3	4	5
Sede	#Total cases		23115		3236	519	5748	13337	275
	Ica		45.1		32.3	67.4	47.2	46.0	71.6
	Piura		54.9		67.7	32.6	52.8	54.0	28.4
Productividad	Median		22.7		34.6	30.7	33.7	16.3	34.2
Producción	Median		788.0		13052.0	626.0	6332.0	265.0	964.0
Horas Laboraras	Median		76.5		375.5	34.2	188.0	27.5	49.0
Productividad	Max.		238.5		203.6	123.7	224.1	238.5	149.3
Producción	Max.		96681.0		96681.0	30463.0	58406.0	25096.0	40975.0
Horas Laboraras	Max.		836.5		836.5	580.5	494.0	251.5	557.5
Productividad	Min.		0.1		0.5	0.4	0.3	0.1	0.4
Producción	Min.		1.0		73.0	3.0	4.0	1.0	3.0
Horas Laboraras	Min.		0.2		61.5	2.0	8.0	0.2	2.5
Sexo	#Total cases		23115		3236	519	5748	13337	275
	Hombre		46.2		41.6	46.2	41.0	49.3	60.4
	Mujer		53.8		58.4	53.8	59.0	50.7	39.6
Rango de edades	#Total cases		23115		3236	519	5748	13337	275
	DE 31 A 50		44.0		48.3	69.7	46.4	40.2	75.6
	MAS DE 50		4.7		4.5	6.6	4.6	4.4	18.9
	MENOR A 30		51.3		47.2	23.7	49.0	55.4	5.5
Grado de Instruccion	#Total cases		18840		2727	513	4865	10460	275
	EDUCACION ESPECIAL		0.0					0.0
	ILETRADO		2.5		4.3	1.4	2.1	2.2	2.5
	PRIMARIA COMPLETA		14.4		18.7	13.5	14.4	13.2	18.2
	PRIMARIA INCOMPLETA		9.7		13.5	5.1	10.3	8.7	6.2
	SECUNDARIA COMPLETA		40.8		34.8	48.9	40.8	41.8	50.5
	SECUNDARIA IMCOMPLETA		31.0		27.6	27.7	30.9	32.5	14.9
	SUPERIOR - TECNICO		1.6		1.1	3.5	1.6	1.5	7.6
Estado Civil	#Total cases		23115		3236	519	5748	13337	275
	Casado(a)/conviviente/unionlibre		7.9		10.4	15.4	7.9	6.6	27.3
	Divorciado(a)/separado(a)		0.1		0.1		0.1	0.1
	Soltero(a)		91.9		89.4	84.6	91.9	93.2	72.7
	Viudo(a)		0.1		0.2		0.1	0.1
Tenencia de Hijos	#Total cases		23115		3236	519	5748	13337	275
	con hijos		52.1		70.9	35.5	64.1	43.6	18.2
	sin hijos		47.9		29.1	64.5	35.9	56.4	81.8
Cantidad de Campañas	#Total cases		23115		3236	519	5748	13337	275
	1		51.9		26.3	4.4	41.7	65.4	4.4
	2		22.9		28.4	9.6	26.3	21.0	6.5
	3		11.5		21.1	15.8	15.3	7.3	15.6
	4		7.9		14.5	28.9	10.0	4.1	27.6
	5		5.7		9.7	41.2	6.7	2.1	45.8
Edad	Mean		31.8		32.4	37.1	32.2	31.0	42.3
Numero de hijos	Mean		0.7		1.0	0.6	0.9	0.6	0.3
Porcentaje de Pobreza	Mean		32.8		32.4	35.3	33.3	32.6	33.8
Dias en la Empresa	Mean		257.5		222.5	1783.9	179.7	166.2	3841.3
Distancia que recorre en metros	Mean		94220.0		58805.4	34180.1	81298.6	114809.8	14069.0
Otros Bonos	Median		0.0		0.0	0.9	0.0	0.0	2.9
Numero de Lotes	Median		4.0		16.0	3.0	8.0	2.0	3.0
Numero de fundos	Median		2.0		4.0	2.0	3.0	1.0	2.0
Numero de variedad	Median		2.0		4.0	1.0	3.0	1.0	1.0
Importe unico	Mean		545.1		1663.1	346.5	826.6	162.7	425.8
Importe Horas extra	Mean		9.8		18.0	26.4	16.4	4.0	26.0
Bono total	Mean		315.3		893.7	157.1	557.0	79.5	196.5
Bono Produccion	Mean		262.5		743.9	151.8	475.8	59.7	183.0
Otros bonos	Mean		1.4		0.6	14.5	1.2	0.8	22.1
Bancarizado	Mean		0.7		0.8	0.9	0.8	0.7	0.9
Peor calificación	#Total cases		23112		3236	519	5748	13334	275
	0.NORMAL		21.0		23.0	39.3	21.4	19.0	50.9
	1.CPP		4.0		3.6	3.7	4.2	4.0	4.7
	2.DEFICIENTE		1.8		1.8	4.0	1.9	1.8	1.5
	3.DUDOSO		2.6		2.8	1.7	2.7	2.6	2.9
	4.EN PERDIDA		23.5		20.5	20.6	22.9	24.8	15.6
	8.SIN CALIFICACION		47.0		48.5	30.6	46.9	47.8	24.4
Moda de Calificación	#Total cases		12191		1661	356	3037	6929	208
	0.NORMAL		52.7		59.0	70.8	54.1	48.8	77.9
	1.CPP		2.2		1.9	2.0	1.9	2.4	1.9
	2.DEFICIENTE		1.3		1.0	1.1	1.6	1.3	1.0
	3.DUDOSO		3.5		2.7	1.7	3.3	4.0	1.9
	4.EN PERDIDA		40.3		35.4	24.4	39.1	43.5	17.3
data_TIPCRE_UM	#Total cases		8528		1199	291	2178	4678	182
	CONSUMO NO REVOLVENTE		49.5		49.3	67.7	48.5	47.6	82.4
	CONSUMO REVOLVENTE		10.8		9.4	18.6	10.4	10.7	14.3
	HIPOTECARIOS PARA VIVIENDA		0.4			0.3	0.5	0.5
	MICROEMPRESAS		37.8		39.7	11.0	39.3	39.7	3.3
	PEQUENAS EMPRESAS		1.5		1.6	2.4	1.3	1.5
Deuda Promedio	Mean		4033.0		3664.6	7576.0	4030.9	3765.7	8040.6
Promedio de Dias de atraso	Mean		1.5		1.4	1.7	1.5	1.5	1.6
			62.2		49.6	61.3	72.5	61.2	46.7

Tabla describe cluster
			#Total		clus_camp
					1 - 19	1 - 20	2 - 19	2 - 20	3 - 19	3 - 20	4 - 19	4 - 20	5 - 19	5 - 20
Importe unico	Mean		545.1		1700.0	1607.8	392.4	287.8	832.9	819.7	180.4	146.2	454.4	391.4
Importe Horas extra	Mean		9.8		19.7	15.5	10.4	46.7	12.8	20.3	3.4	4.5	18.9	34.6
Bono total	Mean		315.3		883.1	909.7	141.9	176.5	469.0	652.9	88.6	71.0	192.7	201.1
Bono Produccion	Mean		262.5		796.7	664.7	124.7	186.3	354.9	607.4	57.2	62.0	165.2	204.4
Otros bonos	Mean		1.4		0.7	0.3	16.8	11.6	0.9	1.4	0.6	0.9	27.5	15.5

# CUARDANDO LA DATA

write.csv(masterip_g1,'cosecha_base_clus.csv',row.names=FALSE)
write.csv(masteripr_g1,'raleo_base_clus.csv',row.names=FALSE)

ARBOL DE CLASIFICACIÓN

masteripr_g1<-masteripr_g1 %>%  mutate(q1 = ntile(data_productividad_per,3))  %>% mutate(productividad_cat=case_when(q1=='1'~'BAJO',q1=='2'~'MEDIO',q1=='3'~'ALTO',TRUE ~ 'OTRO')) %>% dplyr::select(-q1)

masteripr_g1<-masteripr_g1%>% dplyr::select(
                               data_GRADO2,
                                data_sum_variedad_total_AL,
                                data_sum_variedad_total_CC,
                                data_sum_variedad_total_CP,
                                data_sum_variedad_total_JS,
                                data_sum_variedad_total_MG,
                                data_sum_variedad_total_RG,
                                data_sum_variedad_total_SG,
                                data_sum_variedad_total_TC,
                                data_sum_variedad_total_TM,
                                data_sum_variedad_total_VN,
                                data_sum_aux_bono_total,
                                data_sum_hora_extra,
                                data_n_lote,
                                data_n_fundo,
                                data_Testado_civil,
                                data_Tsexo,
                                data_dias_empresa,
                                data_Tedad,
                                data_numero_hijos,
                                data_pobreza,
                                data_n_variedad,
                                data_veces,
                                data_DEUDA_PROM_U6M,
                                data_PEOR_CALIF_U6M,
                                data_MODA_CALIF_U6M,
                                data_NRO_ENT_PROM_U6M,
                                data_TIPCRE_UM,
                                data_DIAS_ATRASO_PROM_U6M,
                                data_BANCARIZADO,
                                data_distancia,
                                data_import_unico,
                                data_bono_produc,
                                data_otros_bono,
                                dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
                                    data_asistente_mediana_Tedad,
                                    data_asistente_mediana_numero_hijos,
                                    data_asistente_dias_empresa,cluster,productividad_cat)

####################################################
# ÁRBOL DE CLASIFICACIÓN CON EL ALGORITMO CART     #
####################################################


set.seed(123)
arbol_1 <- rpart(factor(productividad_cat)~., 
                 data=masteripr_g1, 
                 method="class",
                 parms=list(split='gini'))

#Graficando el árbol

rpart.plot(arbol_1, digits=-1, type=0, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=1, extra=106,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=2, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=3, extra=105,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=4, extra=105,cex = .7, nn=TRUE)

#library(caret)
#varImp(arbol_1)

# Mejorando los Gráficos


plot(as.party(arbol_1), tp_args = list(id = FALSE))


####################################################
# CART CON CARET Y VALIDACIÓN CRUZADA REPETIDA  #
####################################################

Warning message:
“extra=106 but the response has 3 levels (only the 2nd level is displayed)”